home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d17 / pm_ps_bs.arc / PM-PS-BS.PAS < prev   
Pascal/Delphi Source File  |  1987-01-30  |  16KB  |  597 lines
  1. {--------------------------------------------------------------}
  2. {                     BREAK-PM                                 }
  3. {                                                              }
  4. {        PRINTMASTER,PRINT SHOP,BASICA GRAPHIC CONVERTER       }
  5. {                                                              }
  6. {    Input: *.SDR or *.NAM  [ Names of Shape ]                 }
  7. {           *.SHP or *.DAT  [ Shape file ]                     }
  8. {   Output: "shape".BSG     [BASIC file]                       }
  9. {--------------------------------------------------------------}
  10.  
  11. {   This program will convert a PRINTMASTER graphic file into a
  12.   PRINT SHOP graphic file, or PRINT SHOP to PRINTMASTER. It will
  13.   also break up either one and convert them to BASICA graphic
  14.   arrays.
  15.  
  16.      Printmaster graphic files consist of 2 seperate files. A
  17.   'name file' with the extension of .SDR and a 'graphic file'
  18.   with the extension of .SHP .
  19.  
  20.      The name file is an ASCII text file containing the names
  21.   for each graphic in the shape file. A name consists of a
  22.   record with the length of 16 bytes. If a name is less then 16
  23.   bytes, the unused positions are filled with nuls ($00).
  24.  
  25.      Printmaster graphics are 88 dots wide by 52 dots high. They
  26.   are stored in a binary file one after anouther. This takes up
  27.   572 bytes. Added to this are four bytes at the start of each
  28.   graphic and one byte at the end (or between each graphic) for
  29.   a total of 576 bytes per graphic. The first 4 bytes consist of
  30.   $0B (width in bytes of graphic), $34 (54 bits high), $58 (width
  31.   in bits) and $00 (nul byte). The last byte between graphics is
  32.   also a $00.
  33.  
  34.      Print Shop's 'name file' is exactly the same as Printmaster's
  35.   but with the extension of .NAM . The Print Shop graphic file has
  36.   the extension of .DAT and is the same format as a .SHP file with
  37.   exceptions. The four bytes before each graphic and the last byte
  38.   between graphics is missing. In order for Print Shop to "see"
  39.   the files the filename must start with "GR". The program will add
  40.   "GR" to the front of the file name and chop off the end if greater-
  41.   than 8 characters. ie: the PRINTMASTER file STANDARD.SHP would
  42.   convert to a PRINT SHOP file GRSTANDA.DAT.
  43.  
  44.      The BASICA format for the graphic is an array with the first
  45.   two bytes the width of the graphic in bits ($58,$00). The second
  46.   two bytes is the highth in bits ($34,$00). The rest of the array
  47.   is the graphic. This file can be used in BASIC program with the
  48.   PUT command. To use the graphic in FONTASY use the load block
  49.   function.
  50.  
  51.            This software is placed into the public domain by:
  52.  
  53.                          John Paul Michalski
  54.                      Infinity Engineering Services
  55.                          322 W. Palomino Dr.
  56.                          Chandler, AZ   85224
  57.  }
  58.  
  59.  
  60.  
  61. PROGRAM PM_TO_PS_TO_BASICA;
  62.  
  63. TYPE   STRING80     = STRING[80];
  64.        STRING30     = STRING[30];
  65.        STRING16     = STRING[16];
  66.        STRING12     = STRING[12];
  67.        STRING8      = STRING[8];
  68.        STRING4      = STRING[4];
  69.        BINARY       = FILE OF BYTE;
  70.  
  71.  
  72. CONST  ExtNamePM    = '.SDR';
  73.        ExtGraphPM   = '.SHP';
  74.        ExtNamePS    = '.NAM';
  75.        ExtGraphPS   = '.DAT';
  76.        OutExtFile   = '.BSG';
  77.        RetMsg       = 'Enter RETURN to Exit';
  78.        BlankEntry   = '                ';  {16 spaces}
  79.        InPutValid   : set of CHAR = ['0'..'5'];
  80.        PunctLow     : set of BYTE = [33..47];
  81.        PunctMid     : set of BYTE = [58..64];
  82.        PunctHigh    : set of BYTE = [91..96,123..132];
  83.        ConvrType    : array[1..4] of STRING30 =
  84.                                             ('Printmaster  to  Print Shop',
  85.                                              'Print Shop   to  Printmaster',
  86.                                              'Printmaster  to  BASICA block',
  87.                                              'Print Shop   to  BASICA block');
  88.  
  89.  
  90. VAR    TmpLine        : STRING80;
  91.        InputLine      : STRING16;
  92.        TEMPNAME       : STRING16;
  93.        InFileName     : STRING12;
  94.        InFileGraph    : STRING12;
  95.        OutFileName    : STRING12;
  96.        OutFileGraph   : STRING12;
  97.        TEMPSTRING     : STRING8;
  98.        InNameExt      : STRING4;
  99.        OutNameExt     : STRING4;
  100.        InGraphExt     : STRING4;
  101.        OutGraphExt    : STRING4;
  102.        OutNameText    : TEXT;
  103.        InNameFile     : BINARY;
  104.        InGraphFile    : BINARY;
  105.        OutNameFile    : BINARY;
  106.        OutGraphFile   : BINARY;
  107.        ErrorLine      : BYTE;
  108.        TypeConvr      : INTEGER;
  109.        ErrorFlag      : INTEGER;
  110.        CountGraph     : INTEGER;
  111.        SizeFile       : REAL;
  112.        GraphicPointer : REAL;
  113.        keyflag        : BOOLEAN;
  114.  
  115.  
  116.  
  117. PROCEDURE CenterLast (VAR tmpline : STRING80);
  118.  
  119. VAR tmpcol  : INTEGER;
  120. VAR tmpnum  : REAL;
  121. VAR tmprow  : INTEGER;
  122.  
  123. BEGIN
  124.  tmprow := 15;
  125.  GotoXY(1,tmprow);
  126.  ClrEol;
  127.  tmpcol := 35 - Trunc(LENGTH(TmpLine)/2);     {Center Mesage}
  128.  GotoXY(tmpcol,tmprow);
  129.  TextColor(12);
  130.  Write(TmpLine);
  131. END;
  132.  
  133.  
  134. PROCEDURE OpenFile (VAR FileType  : BINARY;
  135.                     VAR FileName  : STRING12;
  136.                     VAR errorflag : INTEGER;
  137.                         InOutFlag : BYTE);
  138.  
  139. BEGIN
  140.  errorflag := 0;
  141.  ASSIGN(FileType,FileName);
  142.  IF InOutFlag = 0 THEN                 {input flag}
  143.   BEGIN
  144.    {$I-}
  145.    RESET(FileType);                    {start at beginning}
  146.    {$I+}
  147.    errorflag := IORESULT;
  148.   END
  149.  ELSE
  150.   REWRITE(FileType);                    {clear for output}
  151. END;
  152.  
  153.  
  154. PROCEDURE CenterLast1 (VAR tmpline : STRING80;
  155.                            endrow  : BYTE);
  156.  
  157. VAR tmpcol  : INTEGER;
  158. VAR tmpnum  : REAL;
  159.  
  160. BEGIN
  161.  GotoXY(1,endrow);
  162.  ClrEol;
  163.  tmpcol := 35 - Trunc(LENGTH(TmpLine)/2);     {Center Mesage}
  164.  GotoXY(tmpcol,endrow);
  165.  TextColor(12);
  166.  Write(TmpLine);
  167. END;
  168.  
  169.  
  170. PROCEDURE ClrError;
  171.  
  172. BEGIN
  173.  GotoXY(1,errorline);
  174.  ClrEol;
  175. END;
  176.  
  177.  
  178. PROCEDURE ErrorMsg (VAR TmpLine   : STRING80);
  179.  
  180. BEGIN
  181.  CenterLast(TmpLine);
  182.  DELAY(1200);
  183.  ClrError;
  184.  TextColor(3);
  185. END;
  186.  
  187.  
  188. FUNCTION  UpperCase (tempname : STRING8): STRING8;
  189.  
  190. VAR point      : integer;
  191.  
  192. BEGIN
  193.   FOR point := 1 to LENGTH(tempname) DO
  194.    tempname[point] := UpCase(tempname[point]);
  195.   UpperCase := tempname
  196. END;
  197.  
  198.  
  199. PROCEDURE WriteEntry  (colplace : INTEGER;
  200.                        rowplace : INTEGER;
  201.                        filename : STRING16;
  202.                        tempname : STRING16);
  203.  
  204. BEGIN
  205.  GotoXY(colplace,rowplace);
  206.  Write(filename);
  207.  GotoXY(colplace+40,rowplace);
  208.  Write(tempname);
  209. END;
  210.  
  211.  
  212. PROCEDURE GetFileName (VAR FileInName   : STRING12;
  213.                        VAR FileInGraph  : STRING12;
  214.                        VAR FileOutName  : STRING12;
  215.                        VAR FileOutGraph : STRING12;
  216.                        VAR errorflag    : INTEGER);
  217.  
  218. VAR tempstring : STRING80;
  219. VAR namestring : STRING8;
  220. VAR temppoint  : INTEGER;
  221.  
  222.  
  223. BEGIN
  224.  errorflag := 0;
  225.  tempstring := 'Enter File ( RETURN to Exit)';
  226.  CenterLast(tempstring);
  227.  WriteEntry(18,4,BlankEntry,BlankEntry);  {clear line}
  228.  WriteEntry(18,5,BlankEntry,BlankEntry);  {clear line}
  229.  TextColor(2);
  230.  GotoXY(18,4);
  231.  ReadLn(tempstring);
  232.  IF Length(tempstring) = 0 THEN
  233.   BEGIN
  234.    errorflag := 99;
  235.    EXIT;
  236.   END;
  237.  namestring := Copy(tempstring,1,8);
  238.  namestring := UpperCase(namestring);
  239.  temppoint := POS('.',namestring)-1;
  240.  IF temppoint >= 0 THEN
  241.   namestring := Copy(namestring,1,temppoint);
  242.  FileInName := namestring+InNameExt;
  243.  FileInGraph := namestring+InGraphExt;
  244.  IF TypeConvr = 1 THEN
  245.   Insert('GR',namestring,1);
  246.  FileOutName := namestring+OutNameExt;
  247.  FileOutGraph := namestring+OutGraphExt;
  248.  WriteEntry(18,4,BlankEntry,BlankEntry);
  249.  WriteEntry(18,4,FileInName,FileInGraph);
  250.  IF (TypeConvr = 3) OR (TypeConvr = 4) THEN
  251.   WriteEntry(18,5,FileOutName,BlankEntry)
  252.  ELSE
  253.   WriteEntry(18,5,FileOutName,FileOutGraph);
  254. END;
  255.  
  256.  
  257.  
  258. PROCEDURE  SetScrn (typeconvr : integer);
  259.  
  260. BEGIN
  261.  TextMode(3);
  262.  TextBackGround(0);
  263.  TextColor(14);
  264.  ClrScr;
  265.  GotoXY(20,2);
  266.  WriteLn(ConvrType[TypeConvr]);
  267.  TextColor(3);
  268.  GotoXY(1,4);
  269.  IF (typeconvr = 1) OR (typeconvr = 3) THEN
  270.   BEGIN
  271.    WriteLn('Source file.SDR:                        Source file.SHP: ');
  272.    InNameExt := '.SDR';
  273.    InGraphExt := '.SHP';
  274.   END;
  275.  IF (typeconvr = 2) OR (typeconvr = 4) THEN
  276.   BEGIN
  277.    WriteLn('Source file.NAM:                        Source file.DAT: ');
  278.    InNameExt := '.NAM';
  279.    InGraphExt := '.DAT';
  280.   END;
  281.  IF typeconvr = 1 THEN
  282.   BEGIN
  283.    WriteLn('Output file.NAM:                        Output file.DAT: ');
  284.    OutGraphExt := '.DAT';
  285.    OutNameExt  := '.NAM';
  286.   END;
  287.  IF typeconvr = 2 THEN
  288.   BEGIN
  289.    WriteLn('Output file.SDR:                        Output file.SHP: ');
  290.    OutGraphExt := '.SHP';
  291.    OutNameExt  := '.SDR';
  292.   END;
  293.  IF (typeconvr = 3) OR (typeconvr = 4) THEN
  294.   BEGIN
  295.    WriteLn('Output file.BTX: ');
  296.    OutGraphExt := '.BSG';
  297.    OutNameExt  := '.BTX';
  298.   END;
  299.  WriteLn(' ');
  300.  WriteLn(' ');
  301.  WriteLn('          Converting       of       Graphics');
  302.  WriteLn(' ');
  303.  Write('   Graphic Name: ');
  304.  IF (typeconvr = 3) OR (typeconvr = 4) THEN
  305.   WriteLn('                      Graphic File.BSG: ');
  306. END;
  307.  
  308.  
  309. PROCEDURE  GetGraphName  (VAR  FILENAME : STRING16);
  310.  
  311. VAR loop     : INTEGER;
  312. VAR tempchr  : BYTE;
  313. VAR tempname : STRING16;
  314. VAR colplace : INTEGER;
  315. VAR rowplace : INTEGER;
  316.  
  317. BEGIN
  318.  colplace := 18;
  319.  rowplace := 10;
  320.  tempname := '';
  321.  FILENAME := '';
  322.  WriteEntry(colplace,rowplace,BlankEntry,BlankEntry);
  323.  FOR loop := 1 TO 16 DO
  324.   BEGIN
  325.    READ(InNameFile,tempchr);
  326.    tempname := tempname+Chr(tempchr);
  327.    IF tempchr IN PunctLow THEN         {Avoid punctuation}
  328.     tempchr := tempchr+64;
  329.    IF tempchr IN PunctMid THEN
  330.     tempchr := tempchr+40;
  331.    IF tempchr IN PunctHigh THEN
  332.     tempchr := tempchr-7;
  333.    IF tempchr > 32 THEN
  334.     FILENAME := FILENAME+Chr(tempchr);
  335.   END;
  336.  DELETE(FILENAME,9,8);                {shorten to file name size}
  337.  filename := UpperCase(filename);
  338.  Filename := filename+'.BSG';
  339.  WriteEntry(colplace,rowplace,tempname,filename);
  340.  END;
  341.  
  342.  
  343. PROCEDURE  LoadGraphic  (VAR GraphicPointer : REAL;
  344.                          VAR        keyflag : BOOLEAN);
  345.  
  346. VAR loop : INTEGER;
  347. VAR waste : BYTE;
  348. VAR temp : string8;
  349.  
  350. BEGIN
  351.  waste := 88;
  352.  WRITE(OutGraphFile,waste);                   {BASIC File Header}
  353.  waste := 0;
  354.  WRITE(OutGraphFile,waste);
  355.  waste := 52;
  356.  WRITE(OutGraphFile,waste);
  357.  waste := 0;
  358.  WRITE(OutGraphFile,waste);
  359.  IF TypeConvr = 3 THEN
  360.   GraphicPointer := GraphicPointer+4;     {Printmaster Skip first 4 bytes}
  361.  LongSeek(InGraphFile,GraphicPointer);
  362.  FOR loop := 0 TO 571 DO
  363.   BEGIN
  364.    READ(InGraphFile,waste);
  365.    WRITE(OutGraphFile,waste);
  366.    keyflag := KeyPressed;               {Check for Exit}
  367.   END;
  368.  GraphicPointer := GraphicPointer+572;  {point to next record}
  369.  IF TypeConvr = 3 THEN
  370.   GraphicPointer := GraphicPointer+1;   {skip Printmaster nul byte}
  371. END;
  372.  
  373.  
  374. PROCEDURE DispExitMsg;
  375.  
  376. BEGIN
  377.  TmpLine :='Hit Any Key to Exit Conversion';
  378.  CenterLast(TmpLine);
  379.  TextColor(14);
  380. END;
  381.  
  382.  
  383. PROCEDURE  BreakCheck ( VAR errorflag : INTEGER;
  384.                         VAR   keyflag : BOOLEAN);
  385.  
  386. VAR tempchr  : CHAR;
  387. VAR templine : STRING80;
  388. VAR tmpcol   : INTEGER;
  389.  
  390. BEGIN
  391.  errorflag := 0;
  392.  IF keyflag THEN
  393.   BEGIN
  394.    GotoXY(1,15);
  395.    ClrEol;
  396.    TmpLine := 'Are You Sure? (Y) ';
  397.    CenterLast(TmpLine);
  398.    Read(tempchr);
  399.    keyflag := FALSE;
  400.    GotoXY(1,15);
  401.    ClrEol;
  402.    IF UpperCase(tempchr) = 'Y' THEN
  403.     BEGIN
  404.      errorflag :=1;
  405.      EXIT;
  406.     END;
  407.    DispExitMsg;
  408.   END;
  409. END;
  410.  
  411.  
  412. PROCEDURE SetOpenScreen  (VAR intype  : INTEGER);
  413.  
  414. VAR tempchr : CHAR;
  415.  
  416. BEGIN
  417.  TextMode(3);
  418.  TextBackGround(0);
  419.  TextColor(14);
  420.  ClrScr;
  421.  GotoXY(14,2);
  422.  WriteLn('PrintMaster - Print Shop - BASICA Graphic Converter');
  423.  GotoXY(1,10);
  424.  TextColor(13);
  425.  WriteLn('                     1: ',ConvrType[1]);
  426.  WriteLn('                     2: ',ConvrType[2]);
  427.  WriteLn('                     3: ',ConvrType[3]);
  428.  WriteLn('                     4: ',ConvrType[4]);
  429.  WriteLn(' ');
  430.  WriteLn('                     0: Exit to DOS');
  431.  WriteLn(' ');
  432.  WriteLn('                     Which conversion? (1-4):  ');
  433.  REPEAT
  434.   BEGIN
  435.    GotoXY(48,17);
  436.    ClrEol;
  437.    Read(tempchr);
  438.   END;
  439.  UNTIL tempchr IN InPutValid;
  440.  intype := ORD(tempchr)-48;
  441. END;
  442.  
  443.  
  444.  
  445. PROCEDURE UpdateCount (VAR countgraph : INTEGER);
  446.  
  447. BEGIN
  448.   CountGraph := CountGraph+1;
  449.   GotoXY(23,8);
  450.   Str(CountGraph,tempstring);
  451.   Write(tempstring:3);              {update file count}
  452.  END;
  453.  
  454.  
  455. PROCEDURE PmPsToBSG;
  456.  
  457. VAR temperror : INTEGER;
  458. VAR filename  : STRING16;
  459.  
  460. BEGIN
  461.  Close(OutNameFile);
  462.  ASSIGN(OutNameText,OutFileName);
  463.  REWRITE(OutNameText);
  464.  REPEAT                                {Convert each file}
  465.   BEGIN
  466.    BreakCheck(errorflag,keyflag);
  467.    IF errorflag = 0 THEN
  468.     BEGIN
  469.      UpdateCount(CountGraph);
  470.      GetGraphName(filename);
  471.      OutFileGraph := filename;
  472.      WriteLn(OutNameText,OutFileGraph);
  473.      OpenFile(OutGraphFile,OutFileGraph,temperror,1);
  474.      LoadGraphic(GraphicPointer,keyflag);
  475.      Close(OutGraphFile);
  476.      IF (FilePos(InNameFile)+16) > FileSize(InNameFile) THEN
  477.       errorflag := 1;
  478.     END;
  479.   END;
  480.  UNTIL errorflag = 1;
  481.  Close(OutNameText);
  482. END;
  483.  
  484.  
  485. PROCEDURE PmToPS;
  486.  
  487. VAR tempchr  : BYTE;
  488. VAR tempname : STRING16;
  489. VAR loop     : INTEGER;
  490. VAR count    : INTEGER;
  491.  
  492. BEGIN
  493.  OpenFile(OutGraphFile,OutFileGraph,errorflag,1);
  494.  REPEAT                                {Convert each file}
  495.   BreakCheck(errorflag,keyflag);
  496.   IF errorflag = 0 THEN
  497.    BEGIN
  498.     GotoXY(18,10);
  499.     ClrEol;
  500.     Tempname := '';
  501.     FOR loop := 1 TO 16 DO
  502.      BEGIN
  503.       Read(InNameFile,tempchr);
  504.       Tempname := Tempname+Chr(tempchr);
  505.       Write(OutNameFile,tempchr);
  506.      END;
  507.     Write(tempname);
  508.     UpdateCount(CountGraph);
  509.     IF TypeConvr = 2 THEN
  510.      BEGIN
  511.       tempchr := $0B;
  512.       Write(OutGraphFile,tempchr);       {Printmaster header}
  513.       tempchr := $34;
  514.       Write(OutGraphFile,tempchr);
  515.       tempchr := $58;
  516.       Write(OutGraphFile,tempchr);
  517.       tempchr := $00;
  518.       Write(OutGraphFile,tempchr);
  519.      END;
  520.     IF TypeConvr = 1 THEN
  521.      BEGIN
  522.       Read(InGraphFile,tempchr);         {dump Printmaster header}
  523.       Read(InGraphFile,tempchr);
  524.       Read(InGraphFile,tempchr);
  525.       Read(InGraphFile,tempchr);
  526.      END;
  527.     FOR loop := 0 TO 571 DO
  528.      BEGIN
  529.       Read(InGraphFile,tempchr);
  530.       Write(OutGraphFile,tempchr);
  531.       keyflag := KeyPressed;               {Check for Exit}
  532.      END;
  533.     IF TypeConvr = 1 THEN
  534.      Read(InGraphFile,tempchr);         {dump last byte}
  535.     IF TypeConvr = 2 THEN
  536.      BEGIN
  537.       tempchr := $00;
  538.       Write(OutGraphFile,tempchr);       {add last byte}
  539.      END;
  540.     IF EOF(InNameFile) THEN
  541.      errorflag := 1;
  542.    END;
  543.  UNTIL errorflag = 1;
  544.  Close(OutGraphFile);
  545.  Close(OutNameFile);
  546. END;
  547.  
  548.  
  549. BEGIN  {Main Program}
  550.  REPEAT                                {Keep coming back to begining}
  551.   ErrorLine := 15;
  552.   SetOpenScreen(TypeConvr);
  553.   IF TypeConvr = 0 THEN
  554.    BEGIN
  555.     ClrScr;
  556.     EXIT;
  557.    END;
  558.   SetScrn(TypeConvr);
  559.   REPEAT
  560.    tmpline := 'Source file not found';
  561.    GetFileName(InFileName,InFileGraph,OutFileName,OutFileGraph,errorflag);
  562.    IF errorflag = 0 THEN                 {Exit if >0}
  563.     BEGIN
  564.      OpenFile(InGraphFile,InFileGraph,errorflag,0);
  565.      IF errorflag = 0 THEN
  566.       OpenFile(InNameFile,InFileName,errorflag,0);
  567.      IF errorflag > 0 THEN
  568.       ErrorMsg(tmpline);
  569.     END;
  570.   UNTIL (errorflag = 0) OR (errorflag = 99);
  571.   IF errorflag <> 99 THEN               {Not return to first menu}
  572.    BEGIN
  573.     ClrError;
  574.     sizefile := LongFileSize(InNameFile);
  575.     Str(TRUNC(SizeFile/16),tempstring);
  576.     GotoXY(32,8);
  577.     IF Length(tempstring) < 3 THEN
  578.     GotoXY(33,8);
  579.     TextColor(14);
  580.     Write(tempstring);
  581.     CountGraph := 0;
  582.     OpenFile(OutNameFile,OutFileName,errorflag,1);
  583.     keyflag := FALSE;
  584.     DispExitMsg;
  585.     GraphicPointer := 0;
  586.     IF (TypeConvr = 3) OR (TypeConvr = 4) THEN
  587.      PmPsToBsg;
  588.     IF (TypeConvr = 1) OR (TypeConvr = 2) THEN
  589.      PmToPs;
  590.     Close(InNameFile);
  591.    END
  592.  UNTIL 1<>1                            {Force back to begining}
  593. END.
  594.  
  595.  
  596.  
  597.